VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "IGame"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Const m_nAnimationLength As Long = 4& 'must be power of 2

Private Declare Function FrameRect Lib "user32.dll" (ByVal hdc As Long, ByRef lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function FillRect Lib "user32.dll" (ByVal hdc As Long, ByRef lpRect As RECT, ByVal hBrush As Long) As Long
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private m_nUserData As Long
Private m_objCallback As IGame

Private m_tOriginalLevel As typeFakeBoxLevel
Private m_tCurrentLevel As typeFakeBoxLevel
Private m_nCurrentBrush As Long

Private m_tLevelUndo(31) As typeFakeBoxLevel
Private m_nLevelUndoCurrent As Long
Private m_nLevelUndoCount As Long

Private m_bTimerEnabled As Boolean

'for edit mode
Private m_bDragging As Boolean

'for game mode
Private m_nAnimationData(g_nMaxWidth - 1, g_nMaxHeight - 1) As Byte
'0=no animation
'&H10-&H1F=eliminating
'&H20-&H2F=falling
'&H30-&H3F=swapping
Private m_nAnimationMode As Long
Private m_nSelectedX As Long, m_nSelectedY As Long
Private m_nHighlightX As Long, m_nHighlightY As Long

Friend Property Get UserData() As Long
UserData = m_nUserData
End Property

Friend Property Let UserData(ByVal n As Long)
m_nUserData = n
End Property

Friend Property Get CallbackObject() As IGame
Set CallbackObject = m_objCallback
End Property

Friend Property Set CallbackObject(ByVal obj As IGame)
Set m_objCallback = obj
End Property

Friend Property Get MaxMoves() As Long
MaxMoves = m_tCurrentLevel.nMaxMoves
End Property

Friend Sub StartGame(ByRef tLevel As typeFakeBoxLevel, Optional ByVal bEditMode As Boolean)
m_tCurrentLevel = tLevel
m_tCurrentLevel.nCurrentMoves = 0
m_tOriginalLevel = m_tCurrentLevel
'///
m_bTimerEnabled = False
m_nAnimationMode = 0
m_nSelectedX = -1
m_nSelectedY = -1
m_nLevelUndoCurrent = 0
m_nLevelUndoCount = 0
If Not bEditMode Then UpdateAnimation
'///
If Not m_objCallback Is Nothing Then
 m_objCallback.UpdateMovesCallback Me, 0, m_tCurrentLevel.nMaxMoves
 m_objCallback.RedrawCallback Me
End If
End Sub

Friend Function Undo() As Boolean
If m_nLevelUndoCurrent > 0 Then
 m_nLevelUndoCurrent = m_nLevelUndoCurrent - 1
 m_nAnimationMode = 0
 m_nSelectedX = -1
 m_nSelectedY = -1
 If m_nLevelUndoCurrent > 0 Then
  m_tCurrentLevel = m_tLevelUndo(m_nLevelUndoCurrent - 1)
  m_bTimerEnabled = False
 Else
  m_tCurrentLevel = m_tOriginalLevel
  UpdateAnimation
 End If
 If Not m_objCallback Is Nothing Then
  m_objCallback.UpdateMovesCallback Me, m_tCurrentLevel.nCurrentMoves, m_tCurrentLevel.nMaxMoves
  m_objCallback.RedrawCallback Me
 End If
 '///
 Undo = True
Else
 Beep
End If
End Function

Friend Function Redo() As Boolean
If m_nLevelUndoCurrent < m_nLevelUndoCount Then
 m_tCurrentLevel = m_tLevelUndo(m_nLevelUndoCurrent)
 m_nLevelUndoCurrent = m_nLevelUndoCurrent + 1
 m_nAnimationMode = 0
 m_nSelectedX = -1
 m_nSelectedY = -1
 m_bTimerEnabled = False
 If Not m_objCallback Is Nothing Then
  m_objCallback.UpdateMovesCallback Me, m_tCurrentLevel.nCurrentMoves, m_tCurrentLevel.nMaxMoves
  m_objCallback.RedrawCallback Me
 End If
 '///
 Redo = True
Else
 Beep
End If
End Function

Friend Sub OnTimer()
If Not m_bTimerEnabled Then Exit Sub
'///
UpdateAnimation
If Not m_objCallback Is Nothing Then m_objCallback.RedrawCallback Me
End Sub

Friend Property Get TimerEnabled() As Boolean
TimerEnabled = m_bTimerEnabled
End Property

Friend Sub Redraw(ByVal bm As cDIBSection, ByRef g As typeGraphics, Optional ByVal bEditMode As Boolean)
Dim r As RECT, r2 As RECT
Dim i As Long, j As Long
Dim d As Long
'///
bm.Cls
'///boxes (with animation)
For j = 0 To g_nMaxHeight - 1
 r.Top = r.Bottom
 r.Right = 0
 r.Bottom = r.Top + 32&
 For i = 0 To g_nMaxWidth - 1
  r.Left = r.Right
  r.Right = r.Left + 32&
  '///
  d = m_tCurrentLevel.b(i, j)
  Select Case d
  Case 1 To 15
   If m_nAnimationMode < &H10& Then
    FillRect bm.hdc, r, g.nBrushes(d)
   ElseIf m_nAnimationMode < &H20& Then
    'eliminating
    If m_nAnimationData(i, j) = 0 Or (m_nAnimationMode And 1&) <> 0 Then FillRect bm.hdc, r, g.nBrushes(d)
   ElseIf m_nAnimationMode < &H30& Then
    'falling
    r2 = r
    If j < m_nAnimationData(i, 0) Then
     r2.Top = r2.Top + (m_nAnimationMode - &H20&) * (32& \ m_nAnimationLength)
     r2.Bottom = r2.Top + 32&
    End If
    FillRect bm.hdc, r2, g.nBrushes(d)
   ElseIf m_nAnimationMode < &H40& Then
    'swapping
    r2.Left = r.Left
    r2.Top = r.Top
    If i = m_nAnimationData(0, 0) And j = m_nAnimationData(1, 0) Then
     r2.Left = r2.Left + (m_nAnimationData(2, 0) - i) * (m_nAnimationMode - &H30&) * (32& \ m_nAnimationLength)
     r2.Top = r2.Top + (m_nAnimationData(3, 0) - j) * (m_nAnimationMode - &H30&) * (32& \ m_nAnimationLength)
    ElseIf i = m_nAnimationData(2, 0) And j = m_nAnimationData(3, 0) Then
     r2.Left = r2.Left + (m_nAnimationData(0, 0) - i) * (m_nAnimationMode - &H30&) * (32& \ m_nAnimationLength)
     r2.Top = r2.Top + (m_nAnimationData(1, 0) - j) * (m_nAnimationMode - &H30&) * (32& \ m_nAnimationLength)
    End If
    r2.Right = r2.Left + 32&
    r2.Bottom = r2.Top + 32&
    FillRect bm.hdc, r2, g.nBrushes(d)
   End If
  End Select
  '///
 Next i
Next j
'///edit mode
If bEditMode Then
 r.Top = 0
 r.Right = 0
 r.Bottom = 16
 For i = 0 To 15
  r.Left = r.Right
  r.Right = r.Right + 16
  FillRect bm.hdc, r, g.nBrushes(i)
  If i = m_nCurrentBrush Then
   r2.Left = r.Left + 4
   r2.Top = r.Top + 4
   r2.Right = r.Right - 4
   r2.Bottom = r.Bottom - 4
   FillRect bm.hdc, r2, g.nBrushes(i + 16)
  End If
 Next i
Else
 '///game mode
 If m_nSelectedX >= 0 And m_nSelectedY >= 0 Then
  r.Left = m_nSelectedX * 32& + 8&
  r.Top = m_nSelectedY * 32& + 8&
  r.Right = r.Left + 16&
  r.Bottom = r.Top + 16&
  i = m_tCurrentLevel.b(m_nSelectedX, m_nSelectedY) And &HF&
  FillRect bm.hdc, r, g.nBrushes(i + 16)
 End If
 If m_nHighlightX >= 0 And m_nHighlightY >= 0 Then
  r.Left = m_nHighlightX * 32& + 6&
  r.Top = m_nHighlightY * 32& + 6&
  r.Right = r.Left + 20&
  r.Bottom = r.Top + 20&
  i = m_tCurrentLevel.b(m_nHighlightX, m_nHighlightY) And &HF&
  j = g.nBrushes(i + 16)
  FrameRect bm.hdc, r, j
  r.Left = r.Left - 2
  r.Top = r.Top - 2
  r.Right = r.Right + 2
  r.Bottom = r.Bottom + 2
  FrameRect bm.hdc, r, j
 End If
End If
'///
End Sub

Friend Sub UpdateAnimation()
Dim i As Long, j As Long, k As Long, kk As Long
'///check existing animation
If m_nAnimationMode < &H10& Then
ElseIf m_nAnimationMode < &H20& Then
 'eliminating
 m_nAnimationMode = m_nAnimationMode + 1
 If m_nAnimationMode >= &H10& + m_nAnimationLength Then
  For j = 0 To g_nMaxHeight - 1
   For i = 0 To g_nMaxWidth - 1
    If m_nAnimationData(i, j) Then m_tCurrentLevel.b(i, j) = 0
   Next i
  Next j
  m_nAnimationMode = 0
 End If
ElseIf m_nAnimationMode < &H30& Then
 'falling
 m_nAnimationMode = m_nAnimationMode + 1
 If m_nAnimationMode >= &H20& + m_nAnimationLength Then
  For i = 0 To g_nMaxWidth - 1
   k = m_nAnimationData(i, 0)
   If k > 0 Then
    For j = k To 1 Step -1
     m_tCurrentLevel.b(i, j) = m_tCurrentLevel.b(i, j - 1)
    Next j
    m_tCurrentLevel.b(i, 0) = 0
   End If
  Next i
  m_nAnimationMode = 0
 End If
ElseIf m_nAnimationMode < &H40& Then
 'swapping
 m_nAnimationMode = m_nAnimationMode + 1
 If m_nAnimationMode >= &H30& + m_nAnimationLength Then
  i = m_nAnimationData(0, 0)
  j = m_nAnimationData(1, 0)
  k = m_tCurrentLevel.b(i, j)
  m_tCurrentLevel.b(i, j) = m_tCurrentLevel.b(m_nAnimationData(2, 0), m_nAnimationData(3, 0))
  m_tCurrentLevel.b(m_nAnimationData(2, 0), m_nAnimationData(3, 0)) = k
  m_nAnimationMode = 0
 End If
End If
'///check new animation
If m_nAnimationMode = 0 Then
 Erase m_nAnimationData
 '///first check falling animation
 For i = 0 To g_nMaxWidth - 1
  'find first empty block
  For j = g_nMaxHeight - 1 To 0 Step -1
   If m_tCurrentLevel.b(i, j) = 0 Then Exit For
  Next j
  'then find non-empty block
  For j = j To 0 Step -1
   If m_tCurrentLevel.b(i, j) Then Exit For
  Next j
  'check if the block exists
  If j >= 0 Then
   m_nAnimationData(i, 0) = j + 1
   m_nAnimationMode = &H20&
  End If
 Next i
 '///then check eliminating animation
 If m_nAnimationMode = 0 Then
  'horizontal
  For j = 0 To g_nMaxHeight - 1
   k = m_tCurrentLevel.b(0, j)
   For i = 1 To g_nMaxWidth - 2
    kk = m_tCurrentLevel.b(i, j)
    If k Then
     If k = kk Then
      If k = m_tCurrentLevel.b(i + 1, j) Then
       m_nAnimationData(i - 1, j) = 1
       m_nAnimationData(i, j) = 1
       m_nAnimationData(i + 1, j) = 1
       m_nAnimationMode = &H10&
      End If
     End If
    End If
    k = kk
   Next i
  Next j
  'vertical
  For i = 0 To g_nMaxWidth - 1
   k = m_tCurrentLevel.b(i, 0)
   For j = 1 To g_nMaxHeight - 2
    kk = m_tCurrentLevel.b(i, j)
    If k Then
     If k = kk Then
      If k = m_tCurrentLevel.b(i, j + 1) Then
       m_nAnimationData(i, j - 1) = 1
       m_nAnimationData(i, j) = 1
       m_nAnimationData(i, j + 1) = 1
       m_nAnimationMode = &H10&
      End If
     End If
    End If
    k = kk
   Next j
  Next i
 End If
End If
'///over
m_bTimerEnabled = (m_nAnimationMode <> 0)
If m_bTimerEnabled And Not m_objCallback Is Nothing Then
 m_objCallback.EnableTimerCallback Me
End If
If m_nAnimationMode = 0 And m_tCurrentLevel.nCurrentMoves > 0 And m_tCurrentLevel.nCurrentMoves <= 32 Then
 'check win
 j = 0
 For i = 0 To g_nMaxWidth - 1
  j = j + m_tCurrentLevel.b(i, g_nMaxHeight - 1)
 Next i
 If j = 0 Then
  If Not m_objCallback Is Nothing Then
   m_objCallback.LevelFinishedCallback Me
  End If
  Exit Sub
 End If
 'save undo
 m_nLevelUndoCount = m_tCurrentLevel.nCurrentMoves
 m_nLevelUndoCurrent = m_tCurrentLevel.nCurrentMoves
 m_tLevelUndo(m_tCurrentLevel.nCurrentMoves - 1) = m_tCurrentLevel
End If
End Sub

Friend Sub OnMouseDown(ByVal Button As MouseButtonConstants, ByVal Shift As ShiftConstants, ByVal x As Long, ByVal y As Long, Optional ByVal bEditMode As Boolean)
Dim i As Long, j As Long, k As Long
Dim bRedraw As Boolean
'///
m_bDragging = False
'///
If bEditMode Then
 If y < 16 Then
  i = x \ 16&
  If i >= 0 And i < 16 And i <> m_nCurrentBrush Then
   m_nCurrentBrush = i
   bRedraw = True
  End If
 Else
  i = x \ 32&
  j = y \ 32&
  If i >= 0 And j >= 0 And i < g_nMaxWidth And j < g_nMaxHeight Then
   m_bDragging = True
   'FIXME:
   If Button And vbRightButton Then k = 0 _
   Else k = m_nCurrentBrush
   If m_tCurrentLevel.b(i, j) <> k Then
    m_tCurrentLevel.b(i, j) = k
    If Not m_objCallback Is Nothing Then
     m_objCallback.EditLevelCallback Me, i, j, k
    End If
    bRedraw = True
   End If
  End If
 End If
ElseIf Button And vbRightButton Then
 If m_nSelectedX >= 0 And m_nSelectedY >= 0 Then
  m_nSelectedX = -1
  m_nSelectedY = -1
  bRedraw = True
 Else
  Undo
 End If
ElseIf m_tCurrentLevel.nCurrentMoves >= m_tCurrentLevel.nMaxMoves Or m_nAnimationMode <> 0 Then
 Beep
Else
 i = x \ 32&
 j = y \ 32&
 If i >= 0 And j >= 0 And i < g_nMaxWidth And j < g_nMaxHeight Then
  If m_nSelectedX >= 0 And m_nSelectedY >= 0 Then
   If (j = m_nSelectedY And (i = m_nSelectedX - 1 Or i = m_nSelectedX + 1)) _
   Or (i = m_nSelectedX And ((j = m_nSelectedY - 1 And m_tCurrentLevel.b(i, j) <> 0) Or j = m_nSelectedY + 1)) Then
    m_nAnimationData(0, 0) = m_nSelectedX
    m_nAnimationData(1, 0) = m_nSelectedY
    m_nAnimationData(2, 0) = i
    m_nAnimationData(3, 0) = j
    m_nSelectedX = -1
    m_nSelectedY = -1
    m_nAnimationMode = &H30&
    m_tCurrentLevel.nCurrentMoves = m_tCurrentLevel.nCurrentMoves + 1
    UpdateAnimation
    If Not m_objCallback Is Nothing Then
     m_objCallback.UpdateMovesCallback Me, m_tCurrentLevel.nCurrentMoves, m_tCurrentLevel.nMaxMoves
    End If
    Exit Sub
   Else
    Beep
   End If
  ElseIf m_tCurrentLevel.b(i, j) Then
   m_nSelectedX = i
   m_nSelectedY = j
   If Not m_objCallback Is Nothing Then m_objCallback.RedrawCallback Me
   Exit Sub
  Else
   Beep
  End If
 Else
  Beep
 End If
 m_nSelectedX = -1
 m_nSelectedY = -1
 bRedraw = True
End If
'///
If bRedraw And Not m_objCallback Is Nothing Then m_objCallback.RedrawCallback Me
End Sub

Friend Sub OnMouseMove(ByVal Button As MouseButtonConstants, ByVal Key As ShiftConstants, ByVal x As Long, ByVal y As Long, Optional ByVal bEditMode As Boolean)
Dim i As Long, j As Long, k As Long
'///
i = x \ 32&
j = y \ 32&
'///
If Button Then
 If bEditMode And m_bDragging Then
  If i >= 0 And j >= 0 And i < g_nMaxWidth And j < g_nMaxHeight Then
   'FIXME:
   If Button And vbRightButton Then k = 0 _
   Else k = m_nCurrentBrush
   If m_tCurrentLevel.b(i, j) <> k Then
    m_tCurrentLevel.b(i, j) = k
    If Not m_objCallback Is Nothing Then
     m_objCallback.EditLevelCallback Me, i, j, k
     m_objCallback.RedrawCallback Me
    End If
   End If
  End If
 End If
End If
End Sub

Friend Sub OnMouseUp(ByVal Button As MouseButtonConstants, ByVal Key As ShiftConstants, ByVal x As Long, ByVal y As Long, Optional ByVal bEditMode As Boolean)
m_bDragging = False
End Sub

'nIndex should be 0-5
Friend Sub OnKeyDown(ByVal nIndex As Long)
Select Case nIndex
Case 0, 1, 2, 3
 Select Case nIndex
 Case 0 'up
  m_nHighlightY = m_nHighlightY - 1
  If m_nHighlightY < 0 Then m_nHighlightY = g_nMaxHeight - 1
 Case 1 'down
  m_nHighlightY = m_nHighlightY + 1
  If m_nHighlightY >= g_nMaxHeight Then m_nHighlightY = 0
 Case 2 'left
  m_nHighlightX = m_nHighlightX - 1
  If m_nHighlightX < 0 Then m_nHighlightX = g_nMaxWidth - 1
 Case 3 'right
  m_nHighlightX = m_nHighlightX + 1
  If m_nHighlightX >= g_nMaxWidth Then m_nHighlightX = 0
 End Select
 If Not m_objCallback Is Nothing Then m_objCallback.RedrawCallback Me
Case 4 'ok
 OnMouseDown vbLeftButton, 0, m_nHighlightX * 32&, m_nHighlightY * 32&
Case 5 'cancel
 OnMouseDown vbRightButton, 0, m_nHighlightX * 32&, m_nHighlightY * 32&
End Select
End Sub

Public Sub UpdateMovesCallback(ByVal objThis As IGame, ByVal nCurrentMoves As Long, ByVal nMaxMoves As Long)
'
End Sub

Public Sub RedrawCallback(ByVal objThis As IGame)
'
End Sub

Public Sub EnableTimerCallback(ByVal objThis As IGame)
'
End Sub

Public Sub LevelFinishedCallback(ByVal objThis As IGame)
'
End Sub

Public Sub EditLevelCallback(ByVal objThis As IGame, ByVal i As Long, ByVal j As Long, ByVal nValue As Long)
'
End Sub
